home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.49 / mathematik / fktunit.p < prev    next >
Text File  |  1995-06-24  |  5KB  |  116 lines
  1. {---------------------------------------------------------}
  2. { unit      : t_fkt.pas                                   }
  3. {                                                         }
  4. { date      : 20.12.88                                    }
  5. { compiler  : turbo pascal 5.0/5.5                        }
  6. {             MS-DOS 3.3                                  }
  7. {                                                         }
  8. { update    : 20.12.88                                    }
  9. {                                                         }
  10. { Autor     : Reiner Schoelles                            }
  11. {---------------------------------------------------------}
  12. { Diese  Unit enthaelt eine Routine zur Berechnung von    }
  13. { Nullstellen nach dem Bisektionsverfahren und die da-    }
  14. { fuer benoetigte Funktion t_f.                           }
  15. { Der Benutzer muss hier seine eingene Funktion, fuer     }
  16. { die die Nullstellen berechnet werden soll, eintragen.   }
  17. { Vordefiniert ist die Funktion  f(x) = x*x*x-x*x-x-1.    }
  18. { Nullstelle liegt bei x0 = 1.839287 (zum Testen geeignet)}
  19. {---------------------------------------------------------}
  20. unit t_fkt;
  21.  
  22. {---------------------------------------------------------}
  23. { Interface                                               }
  24. {---------------------------------------------------------}
  25. Interface
  26.  
  27.   function t_f(x: real): real;
  28.   function t_bisektion(a,b,epsilon: real;
  29.                        var n      : integer;
  30.                        var t_err  : byte): real;
  31.  
  32. {---------------------------------------------------------}
  33. { Implementation                                          }
  34. {---------------------------------------------------------}
  35. Implementation
  36.  
  37. {---------------------------------------------------------}
  38. { t_f                                                     }
  39. {    Muss an eigene Beduerfnisse angepasst werden. Vor-   }
  40. {    eingestellt ist die Funktion f(x) = x*x*x-x*x-x-1,   }
  41. {    die nach dem Verfahren des fortgesetzten Ausklammerns}
  42. {    folgende Form hat:                                   }
  43. {           f(x) = ((x-1) * x - 1) * x -1                 }
  44. {    Damit ist die Funktion linearisiert und effektiver   }
  45. {    zu berechnen. Sie kann selbstverstaendlich auch in   }
  46. {    der folgenden Form angegeben werden:                 }
  47. {           t_f:= x*x*x-x*x-x-1;                          }
  48. {    Die function t_f wird von der function t_bisektion   }
  49. {    aufgerufen.                                          }
  50. {---------------------------------------------------------}
  51. function t_f;
  52. begin
  53.   t_f:= ((x-1) * x - 1) * x -1;
  54. end;
  55. {---------------------------------------------------------}
  56. { t_bisektion                                             }
  57. {             Die function berechnet nach dem Bisektions- }
  58. {             verfahren Nullstellen von reellwertigen     }
  59. {             Funktionen und gibt die Nullstelle als Er-  }
  60. {             gebnis der function zurueck.                }
  61. {             a und b (a < b) sind die beiden Intervall-  }
  62. {             grenzen, zw. denen eine Nullstelle liegt.   }
  63. {             Die Nullstelle wird als Erg. der function   }
  64. {             geliefert. Liegt ein Fehler vor, ist das    }
  65. {             Ergebnis 0. Die Variable N enthaelt die An- }
  66. {             zahl der Iterationen, die notwendig waren,  }
  67. {             um die Nullstelle mit der angegebenen       }
  68. {             Toleranz epsilon zu ermitteln.              }
  69. {---------------------------------------------------------}
  70. function t_bisektion;
  71.  
  72. var
  73.   stop: boolean;      { true, wenn Nullstelle gefunden }
  74.   c   : real;         { c:= (a+b)/2                    }
  75.  
  76. begin
  77.   stop := false;     { Noch keine Nullstelle }
  78.   t_err:= 0;         { Noch kein Fehler      }
  79.   n    := 0;         { Anfangswert           }
  80.   if a < b           { a < b Bedingung       }
  81.   then begin
  82.          { Vorzeichenwechsel? }
  83.          if ((t_f(a) * t_f(b)) < 0)
  84.          then begin
  85.                 repeat
  86.                   c:= (a+b)/2;  { Intervallhalbierung }
  87.                   n:= n + 1;
  88.                   if  (abs(b-c) <= epsilon)
  89.                   and (t_f(c)   <= epsilon)
  90.                   then begin    { Nullstelle gefunden }
  91.                          stop:= true;
  92.                          t_bisektion:= c;
  93.                        end
  94.                   else begin { Noch keine Nullstelle  }
  95.                          if (t_f(b) * t_f(c) < 0)
  96.                          then a:= c
  97.                          else b:= c;
  98.                        end;
  99.                 until stop;
  100.               end
  101.          else begin { Keine Nullstelle zw. a und b }
  102.                 t_err:= 1;
  103.                 t_bisektion:= 0;
  104.                 n:= 0;
  105.               end;
  106.        end
  107.   else begin { wenn a > b, dann Bedingung verletzt }
  108.          t_err:= 1;
  109.          t_bisektion:= 0;
  110.          n:= 0;
  111.        end;
  112. end;
  113. {---------------------------------------------------------}
  114. { End of Unit                                             }
  115. {---------------------------------------------------------}
  116. end.